COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	% --------Variable naming conventions:------------------------------
C00006 00003	% --------Preamble------------------------------------------------
C00010 00004	% --------Utilities-------------------------------------------------
C00020 00005	% --------Points----------------------------------------------------
C00029 00006	% --------Lines-----------------------------------------------------
C00038 00007	% --------Strokes---------------------------------------------------
C00044 00008	%	  LFLATSTROKE
C00048 00009	%	  RFLATSTROKE
C00052 00010	% --------Dots------------------------------------------------------
C00053 00011	% --------Serifs----------------------------------------------------
C00067 00012	% --------Stroke modification---------------------------------------
C00069 00013	% %	  LFLATTAPER
C00075 ENDMK
C⊗;
% --------Variable naming conventions:------------------------------
% 0-99		Point numbers.
%
% a+100		Left point	|	Make up a single broad-edged pen.
% a+200		Center point	|	Used to index xy variables.
% a+300		Right point	|
%
% a+1100	LDX		|	Slope at a given point.
% a+2100	LDY		|	Used to index w variables.
% a+1300	RDX		|
% a+2300	RDY		|
%
% a b c		Point indices
% --------Preamble------------------------------------------------
	leftedge =100;	% Constant values for passing as switches
	rightedge=300;	% to procedures like serifa
	upperedge=200;
	loweredge=400;

	minvr     0;	% allow sharp turns without correction
	minvs     0;
	maxvr     999999;
	maxvs     999999;

designsize ptsize; % ignore error messages you get with old MF!

fxerox=1.03;	% Xeroxing enlarges by this factor (approximately)
fivemm=5*384/25.4/4;	% this many pixels makes 5mm of proofmode output on Dover

if mode<0:				% negative modes assume that `mag' is set
	mmode=-mode; new mode; mode=mmode;
     else: mag=1; fi;
magnification mag;

      if mode=0:			% for initial design of characters
	proofmode; drawdisplay; titletrace;
	pixels*20/36=fxerox.fxerox.fivemm;
		% matches a drawing that has been xeroxed three times
	blacker=0; overcorr=1;

else: if mode=1:			% XGP, Versatec, Varian, etc.
	fntmode; tfxmode; no modtrace;
	magnification (3.6/200/.013837)mag;
	pixels=3.6mag; blacker=.6; overcorr=.4;	

else: if mode=2:			% Alphatype
	crsmode; tfxmode; titletrace; no modtrace;
	pixels=73.7973; blacker=4; overcorr=1;	

else: if mode=3:			% Dover
	ocmode; tfmmode; dotwdmode; no modtrace;
	overcorr=.6;
	pixels=384*.013837*mag; blacker=0.75;

else: if mode=4:			% Canon
	chrmode; tfxmode; no modtrace;
	pixels=240*.013837*mag;
	blacker=.2; overcorr=.4;

else: if mode=5:			% Zapf
	titletrace; proofmode; no points;
	pixels*20/36=fivemm; blacker=0; overcorr=1;

else: if mode=6:			% Hornet
	fntmode; tfxmode; no modtrace;
	magnification (3.6/300/.013837)mag;
	pixels=3.6mag; blacker=.6; overcorr=.4;	
	
else: if mode=7:			% Proofmode, but without display;
	proofmode; no drawdisplay; titletrace;
	pixels*20/36=fxerox.fxerox.fivemm;
		% matches a drawing that has been xeroxed three times
	blacker=0; overcorr=1;

else:	input mode;

fi; fi; fi; fi; fi; fi; fi; fi;

fontfacebyte 254-2*ptsize;
hresolution pixels; vresolution pixels.



% --------Utilities-------------------------------------------------
subroutine fontbegin:	% Initialize before generating any characters
	no eqtrace;	% Turn off tracing within this subroutine
	new typesize;   % the vertical size of the font
	new cf;         % conversion factor, approximately equal to PIXELS
	new hh,hcap,hdot,hx,ht,hserifa,he,hserifb,hy,htop,hbot;
			% raster-oriented vertical dimensions
	new serifw,hairw,horzw,vertw,diagw,curvew,dotw;
			% raster-oriented pen sizes

	texinfo
	0, 	% Slant. The change in x coordinate per unit y coordinate
		% when TEX is raising or lowering an accent character.
	9pu,    % Space (pts). Standard interword spacing.
	0, 	% Stretch (pts). Glue stretchability for interword spacing.
	0, 	% Shrink (pts). Glue shrinkability for interword spacing.
	5pu,    % x-height (pts). Accents are raised by charht minus this number.
	9pu,    % Quad width (pts) = one emx-height.
	9pu;    % Extra space (pts). Additional interword space after period.

	w0	= round(pixels.pw+blacker);	% ddraw width
    w0+	serifw	= round(pixels.pwi+blacker);	% serif thickness
    w0+	hairw	= round(pixels.pwii+blacker);	% hairline width
    w0+	horzw	= round(pixels.pwiii+blacker);	% horizontal stroke width
    w0+	vertw	= round(pixels.pwiv+blacker);	% vertical stroke width
    w0+	diagw	= round(pixels.pwv+blacker);	% diagonal stroke width
    w0+	curvew	= round(pixels.pwvi+blacker);	% curved stroke width
        dotw	= round(pixels.pwxix+blacker);	% dot diameter

	typesize= ph+pd+2pb; 		% total height of type body in points.
     cf.typesize= pixels.typesize-1;	% Assign value of CF.

	hh	= round cf.ph;		% ascenders
	hcap	= round cf.phh;		% cap height and numeral height
	hdot	= round cf.phi;	 	% center of dot on i and j
	hbx	= round cf.pbx;  	% x-height (for bold chars)
	hx	= round cf.px;    	% x-height
	ht	= round cf.pft;   	% top of bar on f and t
	hserifa	= good0 cf.psa;		% entering serifs
	he	= cf.pe;          	% bar on e
	hserifb	= good0 cf.psb; 	% exiting serifs
	hy	= -round cf.pd;   	% descender depth
	o	= cf.po.overcorr;  	% overshoot
	oh	= cf.poh.overcorr;	% overshoot (horizontal)
	rover	= pweight[1,2]serifw;	% right overshoot (exiting hook serifs)

	border	= -round(.5(hh-hy-typesize.pixels));
	htop	= hh+border;
	hbot	= hy-border;
	maxht htop+4;

	if mode=5: new ls; ls=0; fi;    % cancel letterspacing in "Zapf mode"
.

% -------------------------------------------------------------------
subroutine charbegin
	(var charno,				% seven-bit character code
	var charuw,				% character width in units
	var charph, var charpd, var charpi):	% height, depth, italcorr in points
% .....................................................................
no eqtrace; no calltrace; no drawdisplay;	% no tracing in this subroutine

	new uw;		% the correct character width in units
	new r;		% raster-oriented character width
	new u;		% raster-oriented design unit
	new tu;		% unmodified raster-oriented unit
	new italcorr;   % italic correction
	new lcorr,rcorr;% left and right corrections
	new italicoffset;

	if math=1: italicoffset = charpi/pu;
	     else: italicoffset = 0;				fi;

	rcorr   = italicoffset-ls;
	lcorr   =	      -ls;
	tu      = pu.pixels;
	uw      = charuw-(lcorr+rcorr);
	italcorr= charpi;
	r       = charuw.u
		= round((uw.tu-2).charuw/uw);

	charcode  charno; 
	charic    italcorr;
	charht    charph;
	chardp    charpd;
	charwd    uw.pu; 
	chardw    uw.tu;
	incx      round(-lcorr.u);

	if mode=0: call grid(round lcorr.u,r-round rcorr.u);	fi;
	if mode=5: call corners(round lcorr.u,r-round rcorr.u);	fi;
.

% -------------------------------------------------------------------
subroutine grid(var lfttt, var rttt):
	no drawdisplay; no proofmode; no drawtrace; no plottrace;
	new herex,herey;
	new lftt,rtt,topp,bott;
	lftt    = lfttt;
	 rtt    =  rttt;
	topp    = htop;
	bott    = hbot;
	herey   = bott; call drawhorizontal;
	herex   = lftt; call drawvertical;
.

% .....................................................................
subroutine drawhorizontal:
	call drawh(htop);
	call drawh(hh);
	call drawh(hcap);
	call drawh(hdot);
	call drawh(hbx);
	call drawh(hx);
	call drawh(ht);
	call drawh(hserifa);
	call drawh(he);
	call drawh(hserifb);
	call drawh(0);
	call drawh(hy);
	call drawh(hbot);
.

% .....................................................................
subroutine drawh(var height):
	x1=lftt; y1=height;
	x2= rtt; y2=height;
	cpen; 1 draw 1..2
.

% .....................................................................
subroutine drawvertical:
	y1=bott; y2=topp; cpen;
	if herex≥ rtt: x1=x2=  rtt; 1 draw 1..2;
		 else: x1=x2=herex; 1 draw 1..2; 
		       new herex; herex=x1+u;
		       call drawvertical;
	fi
.

% -------------------------------------------------------------------
subroutine corners(var lfttt, var rttt):
	no drawdisplay; no proofmode; no drawtrace; no plottrace;
	x1    =x2    =x3    =x4    =x5-10 =x6-10	= lfttt;
	x7+10 =x8+10 =x9    =x10   =x11   =x12   	= rttt;
	y1    =y2+10 =y5    =y7    =y9    =y10+10	= hh;
	y3-10 =y4    =y6    =y8    =y11-10=y12   	= 0;
	cpen; 
      1 draw 2..1..  1..5; 
	draw 7..9..  9..10; 
	draw 3..4..  4..6; 
	draw 8..12.. 12..11;
.

% -------------------------------------------------------------------
subroutine error:
	error=1;
	error=2;
.
% --------Points----------------------------------------------------

% -------------------------------------------------------------------
% Equates two zpoints.
subroutine samezpoint(index a,index b):
% .....................................................................
	x(a+100) = x(b+100);	y(a+100) = y(b+100);
	x(a+200) = x(b+200);	y(a+200) = y(b+200);
	x(a+300) = x(b+300);	y(a+300) = y(b+300);
.

% -------------------------------------------------------------------
% Equates two points.
subroutine samepoint(index a,index b):
% .....................................................................
	xa = xb;	ya = yb;
.

% -------------------------------------------------------------------
% Equates the slopes at two points. The FIRST point is declared new.
subroutine sameslope(index a,index b):
% .....................................................................
	new w(a+1100),w(a+2100),w(a+1300),w(a+2300);
	w(a+1100) = w(b+1100);		w(a+2100) = w(b+2100);
	w(a+1300) = w(b+1300);		w(a+2300) = w(b+2300);
.

% -------------------------------------------------------------------
% Computes normal (90 degrees right) to a given direction. 
% Given (px/py), returns (py/-px) normalized as (invertx/inverty).
subroutine norm(var px, var py):
% .....................................................................
	new pnorm, invertx, inverty;
	pnorm = sqrt(px.px+py.py);
	invertx = py/pnorm;
	inverty = -px/pnorm;
.

% -------------------------------------------------------------------
% Polar to rectangular coordinates.
% Positions the "out" at distance "radius" and angle "theta" from "in".
subroutine arm(index in, index out, var radius, var theta):
% .....................................................................
	xout = xin + radius.cosd(theta);
	yout = yin + radius.sind(theta);
.

% ---------------------------------------------------------------------
% Zapf pen. Set the positions of points l and r relative to point c.
subroutine zpen(index a,var lw,var rw,var theta):
% .....................................................................
	call arm((a+100),(a+200),lw,theta);
	call arm((a+200),(a+300),rw,theta);
.

% ---------------------------------------------------------------------
% Balanced zpen. Same as zpen, but always has lw=rw = (.5lrw).
subroutine bzpen(index a,var lrw,var theta):
% .....................................................................
	call arm((a+100),(a+200),.5lrw,theta);
	call arm((a+200),(a+300),.5lrw,theta);
.

% -------------------------------------------------------------------
% Relates l and r along a line of given angle.
% Unlike a zpen, does not specify width.
subroutine angledpen(index a,var theta):
% .....................................................................
	call line((a+100),(a+300),cosd(theta),sind(theta));
.

% -------------------------------------------------------------------
% Set the positions of point a relative to point b,
% at a given relative position.
subroutine position(index a,index b,var dx,var dy):
% .....................................................................
	xa = xb+dx;
	ya = yb+dy;
.

% -------------------------------------------------------------------
% Sets the slopes at points l and r.
subroutine dxylr(   index a,
		    var vldx, var vldy, var vrdx, var vrdy):
% .....................................................................
new w(a+1100),w(a+2100),w(a+1300),w(a+2300);
	w(a+1100) = vldx;
	w(a+2100) = vldy;
	w(a+1300) = vrdx;
	w(a+2300) = vrdy;
.

% -------------------------------------------------------------------
% Same as dxy, except slopes at points l and r are the same.
subroutine dxy(     index a,
		    var vdx, var vdy):
% .....................................................................
new w(a+1100),w(a+2100),w(a+1300),w(a+2300);
	w(a+1100) = vdx;
	w(a+2100) = vdy;
	w(a+1300) = vdx;
	w(a+2300) = vdy;
.

% -------------------------------------------------------------------
% Sets both positions and slopes.
subroutine zpendxy(index a,var lw,var rw,var theta,
		    var vldx, var vldy, var vrdx, var vrdy):
% .....................................................................
	call zpen(a,lw,rw,theta);
	call dxy(a,vldx,vldy,vrdx,vrdy);
.

% -------------------------------------------------------------------
% Chops off an end of a stroke at a given absolute angle
% computing the widths that project onto given left and right widths (alw,arw)
% normal to the direction dx,dy.
subroutine chop(index a,
		var twoalw, var twoarw,
		var anglea, var dx, var dy):
% .....................................................................
	new alw,arw; 2alw = twoalw; 2arw = twoarw;
	call norm(dx,dy);
	new lw,rw,cosine;
	cosine =invertx.cosd(anglea)+inverty.sind(anglea);
		% cosine of the angle
		% between the normal to dx,dy and the desired final angle
	lw.cosine=alw;
	rw.cosine=arw; % project the lengths
	call zpen(a,lw,rw,anglea);
.

% -------------------------------------------------------------------
% Balanced chop. Same as chop, except always uses bzpen instead of zpen.
subroutine bchop(index a,
		var alrw,
		var anglea, var dx, var dy):
% .....................................................................
	call norm(dx,dy);
	new lrw,cosine;
	cosine =invertx.cosd(anglea)+inverty.sind(anglea);
		% cosine of the angle
		% between the normal to dx,dy and the desired final angle
	lrw.cosine=alrw;
	call bzpen(a,lrw,anglea);
.



% --------Lines-----------------------------------------------------

% Relates two points along a line of given slope.
subroutine line(index a,index b,var dx,var dy):
% .....................................................................
	dx(yb-ya) = dy(xb-xa);
.

% -------------------------------------------------------------------
% Relates two points along a line of given angle.
subroutine angledline(index a,index b,var theta):
% .....................................................................
	(cosd theta)(yb-ya) = (sind theta)(xb-xa);
.

% -------------------------------------------------------------------
% Makes three points colinear.
subroutine colinear(index a,index b,index c):
% .....................................................................
	new dummy;
	xb=dummy[xa,xc];
	yb=dummy[ya,yc];
.

% -------------------------------------------------------------------
% Sets slopes so that a straight line will be drawn from A to B.
subroutine lineslope(index a,index b):
% .....................................................................
new w(a+1000),w(a+2000),w(b+1000),w(b+2000);
	w(a+1000) = w(b+1000) = xb-xa;
	w(a+2000) = w(b+2000) = yb-ya;
.

% -------------------------------------------------------------------
% Aims the slope at point a at a point at same y position as b,
% at an x position which is some percentage of the way from a to b.
subroutine htoward(index a,index b,var percentage):
% .....................................................................
new w(a+1000),w(a+2000);
	new aimx; 	aimx = percentage[xa,xb];
	new aimy;	aimy = 		1[ya,yb];
	w(a+1000)  = aimx-xa;
	w(a+2000)  = aimy-ya;
.

% -------------------------------------------------------------------
% Aims the slope at point a at a point at same x position as b,
% at a y position which is some percentage of the way from a to b.
subroutine vtoward(index a,index b,var percentage):
% .....................................................................
new w(a+1000),w(a+2000);
	new aimx; 	aimx =          1[xa,xb];
	new aimy;	aimy = percentage[ya,yb];
	w(a+1000)  = aimx-xa;
	w(a+2000)  = aimy-ya;
.

% -------------------------------------------------------------------
% Aims the slope away from a point a at a point at same y position as b,
% and with an x position which is some percentage of the way from a to b.
subroutine haway(index a,index b,var percentage):
% .....................................................................
new w(a+1000),w(a+2000);
	new aimx; 	aimx = percentage[xa,xb];
	new aimy;	aimy = 		1[ya,yb];
       -w(a+1000)  = aimx-xa;
       -w(a+2000)  = aimy-ya;
.

% -------------------------------------------------------------------
% Aims the slope at point a at a point at same x position as b,
% away from a y position which is some percentage of the way from a to b.
subroutine vaway(index a,index b,var percentage):
% .....................................................................
new w(b+1000),w(b+2000);
	new aimx; 	aimx =          1[xa,xb];
	new aimy;	aimy = percentage[ya,yb];
       -w(a+1000)  = aimx-xa;
       -w(a+2000)  = aimy-ya;
.

% -------------------------------------------------------------------
% Computes (interx,intery) -- the intersection of two lines
% given in point tangent form.
subroutine intersect(index a,index b):
% .....................................................................
	new interx,intery,dummya,dummyb;
	interx = xa+dummya.w(a+1000) = xb+dummyb.w(b+1000);
	intery = ya+dummya.w(a+2000) = yb+dummyb.w(b+2000);
.

% -------------------------------------------------------------------
% Computes (interx,intery) -- the intersection of two lines
% given in two-point form (a..b and c..d).
subroutine ptintersect(index a,index b,
   		       index c,index d):
% .....................................................................
	new interx,intery,dummya,dummyb;
	interx = dummya[xa,xb] = dummyb[xc,xd];
	intery = dummya[ya,yb] = dummyb[yc,yd];
.

% -------------------------------------------------------------------
% Computes (interx,intery) -- the intersection of two lines
% given in point slope form.
subroutine slopeintersect(index a,var adx,var ady,
   		          index b,var bdx,var bdy):
% .....................................................................
	new interx,intery,dummya,dummyb;
	interx = dummya[xa,xa+adx] = dummyb[xb,xb+bdx];
	intery = dummya[ya,yb+ady] = dummyb[yb,yb+bdy];
.

% -------------------------------------------------------------------
% Computes (unitx,unity) -- the unit vector pointing from a to b.
subroutine unitvector(index a,index b):
% .....................................................................
	new unitx,unity,distance;
	distance= sqrt((xb-xa)(xb-xa)+(yb-ya)(yb-ya));
	unitx	= (xb-xa)/distance;	
	unity	= (yb-ya)/distance;	
.

% -------------------------------------------------------------------
% Crawl a given distance, along the line from a to b, computing point c.
subroutine crawl(index a,index b, index c, var distance):
% .....................................................................
	call unitvector(a,b);
	xc	= xa + distance.unitx;
	yc	= ya + distance.unity;
.

% --------Strokes---------------------------------------------------

subroutine taper(	index a, index b, index c,
			var bias,
			var altaper, var artaper, 
			var cltaper, var crtaper,
			var lshrink, var rshrink):
% .....................................................................
%	Calculate the endpoints of the waist as if the
%	stroke were straight. These are strictly local
%	temporary points.
x1 = bias[x(a+100),x(c+100)];
y1 = bias[y(a+100),y(c+100)];
x2 = bias[x(a+300),x(c+300)];
y2 = bias[y(a+300),y(c+300)];

%	Compute the center of the waist as the intersection of
%	the waistline and spine.
call ptintersect((a+200),(c+200),1,2);
x(b+200) = interx;
y(b+200) = intery;

%	Compute the waist endpoints so that the stroke
%	actually gets thinner in the middle.
x(b+100) = lshrink[x(b+200),x1];
y(b+100) = lshrink[y(b+200),y1];
x(b+300) = rshrink[x(b+200),x2];
y(b+300) = rshrink[y(b+200),y2];
% .....................................................................
new w(a+1100),w(a+2100),w(a+1300),w(a+2300);
new w(b+1100),w(b+2100),w(b+1300),w(b+2300);
new w(c+1100),w(c+2100),w(c+1300),w(c+2300);
%	Make the slopes at the waist parallel to the lines
%	connecting corresponding left and right points at
%	end a and end c.
w(b+1100) = lshrink[x(c+200)-x(a+200),x(c+100)-x(a+100)];
w(b+2100) = lshrink[y(c+200)-y(a+200),y(c+100)-y(a+100)];
w(b+1300) = rshrink[x(c+200)-x(a+200),x(c+300)-x(a+300)];
w(b+2300) = rshrink[y(c+200)-y(a+200),y(c+300)-y(a+300)];

%	Assign the slopes at the endpoints 
%	by aiming them at some point along the waist.
w(a+1100) = altaper[x1,x(b+100)] - x(a+100);
w(a+2100) = altaper[y1,y(b+100)] - y(a+100);	
w(a+1300) = artaper[x2,x(b+300)] - x(a+300);
w(a+2300) = artaper[y2,y(b+300)] - y(a+300);

-w(c+1100) = cltaper[x1,x(b+100)] - x(c+100);
-w(c+2100) = cltaper[y1,y(b+100)] - y(c+100);
-w(c+1300) = crtaper[x2,x(b+300)] - x(c+300);
-w(c+2300) = crtaper[y2,y(b+300)] - y(c+300);
.

% ------------------------------------------------------------------
subroutine flareaway(	index a, index b,
			var ltaper, var rtaper, var pshrink):
% .....................................................................
%	Compute unshrunk waist points.
x1	= (1/pshrink)[x(b+200),x(b+100)];
y1	= (1/pshrink)[y(b+200),y(b+100)];
x2	= (1/pshrink)[x(b+200),x(b+300)];
y2	= (1/pshrink)[y(b+200),y(b+300)];

% .....................................................................
%	Assign the slopes at the endpoints 
%	by aiming them at some point along the waist.
new w(a+1100),w(a+2100),w(a+1300),w(a+2300);
w(a+1100) = ltaper[x1,x(b+100)] - x(a+100);
w(a+2100) = ltaper[y1,y(b+100)] - y(a+100);	
w(a+1300) = rtaper[x2,x(b+300)] - x(a+300);
w(a+2300) = rtaper[y2,y(b+300)] - y(a+300);
.

% ------------------------------------------------------------------
subroutine flaretoward(	index b, index c,
			var ltaper, var rtaper, var pshrink):
% .....................................................................
%	Compute unshrunk waist points.
x1	= (1/pshrink)[x(b+200),x(b+100)];
y1	= (1/pshrink)[y(b+200),y(b+100)];
x2	= (1/pshrink)[x(b+200),x(b+300)];
y2	= (1/pshrink)[y(b+200),y(b+300)];

% .....................................................................
%	Assign the slopes at the endpoints 
%	by aiming them at some point along the waist.
new w(c+1100),w(c+2100),w(c+1300),w(c+2300);
-w(c+1100) = ltaper[x1,x(b+100)] - x(c+100);
-w(c+2100) = ltaper[y1,y(b+100)] - y(c+100);
-w(c+1300) = rtaper[x2,x(b+300)] - x(c+300);
-w(c+2300) = rtaper[y2,y(b+300)] - y(c+300);
.

%	  LFLATSTROKE
% -------------------------------------------------------------------
% Similar to taper, except that the left edge is flat.
subroutine lflatstroke(	index a, index b, index c,
			var bias,
			var artaper, 
			var crtaper,
			var rshrink):
% .....................................................................
%	Calculate the endpoints of the waist as if the
%	stroke were straight. These are strictly local
%	temporary points.
x2 = bias[x(a+300),x(c+300)];
y2 = bias[y(a+300),y(c+300)];

%	Compute the center of the waist by dropping a perpendicular
%	to the spine.
call norm(x(c+200)-x(a+200),y(c+200)-y(a+200));
call slopeintersect((a+200),x(c+200)-x(a+200),y(c+200)-y(a+200),
		    2,invertx,inverty);
x(b+200) = interx;
y(b+200) = intery;

%	Compute the waist endpoints so that the stroke
%	actually gets thinner in the middle.
x(b+300) = rshrink[x(b+200),x2];
y(b+300) = rshrink[y(b+200),y2];

% .....................................................................
new w(a+1100),w(a+2100),w(a+1300),w(a+2300);
new w(b+1100),w(b+2100),w(b+1300),w(b+2300);
new w(c+1100),w(c+2100),w(c+1300),w(c+2300);
%	Make the slopes at the waist parallel to the lines
%	connecting corresponding left and right points at
%	end a and end c.
w(b+1300) = rshrink[x(c+200)-x(a+200),x(c+300)-x(a+300)];
w(b+2300) = rshrink[y(c+200)-y(a+200),y(c+300)-y(a+300)];

%	Assign the slopes at the endpoints 
%	by aiming them at some point along the waist.
w(a+1300) = artaper[x2,x(b+300)] - x(a+300);
w(a+2300) = artaper[y2,y(b+300)] - y(a+300);

-w(c+1300) = crtaper[x2,x(b+300)] - x(c+300);
-w(c+2300) = crtaper[y2,y(b+300)] - y(c+300);

% .....................................................................
%	NOW handle the left edge. Draw a straight line from 
%	(a+100) to (c+100), incidentally camoflauging (b+100) with (a+100).
x(b+100) = .5[x(a+100),x(c+100)];
y(b+100) = .5[y(a+100),y(c+100)];

w(a+1100) =
w(b+1100) =
w(c+1100) = x(c+100)-x(a+100);
w(a+2100) =
w(b+2100) =
w(c+2100) = y(c+300)-y(a+300);

.
%	  RFLATSTROKE
% -------------------------------------------------------------------
% Similar to taper, except that the right edge is flat.
subroutine rflatstroke(	index a, index b, index c,
			var bias,
			var altaper, 
			var cltaper,
			var lshrink):
% .....................................................................
%	Calculate the endpoints of the waist as if the
%	stroke were straight. These are strictly local
%	temporary points.
x2 = bias[x(a+100),x(c+100)];
y2 = bias[y(a+100),y(c+100)];

%	Compute the center of the waist by dropping a perpendicular
%	to the spine.
call norm(x(c+200)-x(a+200),y(c+200)-y(a+200));
call slopeintersect((a+200),x(c+200)-x(a+200),y(c+200)-y(a+200),
		    2,invertx,inverty);
x(b+200) = interx;
y(b+200) = intery;

%	Compute the waist endpoints so that the stroke
%	actually gets thinner in the middle.
x(b+100) = lshrink[x(b+200),x2];
y(b+100) = lshrink[y(b+200),y2];

% .....................................................................
new w(a+1100),w(a+2100),w(a+1300),w(a+2300);
new w(b+1100),w(b+2100),w(b+1300),w(b+2300);
new w(c+1100),w(c+2100),w(c+1300),w(c+2300);
%	Make the slopes at the waist parallel to the lines
%	connecting corresponding left and right points at
%	end a and end c.
w(b+1100) = lshrink[x(c+200)-x(a+200),x(c+100)-x(a+100)];
w(b+2100) = lshrink[y(c+200)-y(a+200),y(c+100)-y(a+100)];

%	Assign the slopes at the endpoints 
%	by aiming them at some point along the waist.
w(a+1100) = altaper[x2,x(b+100)] - x(a+100);
w(a+2100) = altaper[y2,y(b+100)] - y(a+100);

-w(c+1100) = cltaper[x2,x(b+100)] - x(c+100);
-w(c+2100) = cltaper[y2,y(b+100)] - y(c+100);

% .....................................................................
%	NOW handle the right edge. Draw a straight line from 
%	(a+300) to (c+300), incidentally camoflauging (b+300) with (a+300).
x(b+300) = .5[x(a+300),x(c+300)];
y(b+300) = .5[y(a+300),y(c+300)];

w(a+1300) =
w(b+1300) =
w(c+1300) = x(c+300)-x(a+300);
w(a+2300) =
w(b+2300) =
w(c+2300) = y(c+300)-y(a+300);

.
% --------Dots------------------------------------------------------

subroutine rdot(var rx, var ry, var size):
new w99; w99=size;
cpen;	rt99x1 = rx;		y1 = ry;
	w99 draw 1;
.

% -------------------------------------------------------------------
subroutine ldot(var lx, var ry, var size):
new w99; w99=size;
cpen;	lft99x1 = lx;		y1 = ry;
	w99 draw 1;
.

% -------------------------------------------------------------------
subroutine cdot(var cx, var ry, var size):
new w99; w99=size;
cpen;	x1 = cx;		y1 = ry;
	w99 draw 1;
.



% --------Serifs----------------------------------------------------

% [from A ---- flat ---- B ---- .... ]
%
% The positions of the points of horizontal tangency are specified differently:
% x-position is given as a percentage from a to b,
% y-position is given in units.
%
% Variants:	hookaserif -- the tangents are computed for a (entering)
%		hookbserif -- the tangents are computed for b (exiting)
%
subroutine hookaserif
	(index a, index flat, index b,
	 var vxflatl, var vyflatl, var vxflatr, var vyflatr, 
	 var valaimf, var varaimf,
	 var upiswhichway):
% .....................................................................
% Position the points of tangency.
cpen;
if upiswhichway=leftedge:
	x(flat+100)	= vxflatl[x(a+100),x(b+100)];
   top0	y(flat+100)	= good0 vyflatl;
	x(flat+300)	= vxflatr[x(a+300),x(b+300)];
   bot0	y(flat+300)	= good0 vyflatr;
else: if upiswhichway=rightedge:
	x(flat+100)	= vxflatl[x(a+100),x(b+100)];
   bot0	y(flat+100)	= good0 vyflatl;
	x(flat+300)	= vxflatr[x(a+300),x(b+300)];
   top0	y(flat+300)	= good0 vyflatr;
else: call error;
fi; fi;

new w(flat+1100),w(flat+2100),w(flat+1300),w(flat+2300);
new w(a+1100),w(a+2100),w(a+1300),w(a+2300);
% and set the slope horizontal.
	w(flat+1100)=x(b+100)-x(a+100);	w(flat+2100)=0;
	w(flat+1300)=x(b+100)-x(a+100);	w(flat+2300)=0;

	w(a+1100)	= (x(flat+100)-x(a+100))valaimf;
	w(a+2100)	=  y(flat+100)-y(a+100);
	w(a+1300)	= (x(flat+300)-x(a+300))varaimf;
	w(a+2300)	=  y(flat+300)-y(a+300);
.

% -------------------------------------------------------------------
subroutine hookbserif
	(index a, index flat, index b,
	 var vxflatl, var vyflatl, var vxflatr, var vyflatr, 
	 var vblaimf, var vbraimf,
	 var upiswhichway):
% .....................................................................
% Position the points of tangency.
cpen;
if upiswhichway=leftedge:
	x(flat+100)	= vxflatl[x(a+100),x(b+100)];
   top0	y(flat+100)	= good0 vyflatl;
	x(flat+300)	= vxflatr[x(a+300),x(b+300)];
   bot0	y(flat+300)	= good0 vyflatr;
else: if upiswhichway=rightedge:
	x(flat+100)	= vxflatl[x(a+100),x(b+100)];
   bot0	y(flat+100)	= good0 vyflatl;
	x(flat+300)	= vxflatr[x(a+300),x(b+300)];
   top0	y(flat+300)	= good0 vyflatr;
else: call error;
fi; fi;

new w(flat+1100),w(flat+2100),w(flat+1300),w(flat+2300);
new w(b+1100),w(b+2100),w(b+1300),w(b+2300);
% and set the slope horizontal.
	w(flat+1100)=x(b+100)-x(a+100);	w(flat+2100)=0;
	w(flat+1300)=x(b+100)-x(a+100);	w(flat+2300)=0;

% Aim the exiting slopes.
	w(b+1100)	= (x(b+100)-x(flat+100))vblaimf;
	w(b+2100)	=  y(b+100)-y(flat+100);
	w(b+1300)	= (x(b+300)-x(flat+300))vbraimf;
	w(b+2300)	=  y(b+300)-y(flat+300);
.

% -------------------------------------------------------------------
% [from A ---- flat ---- B ---- .... ]
%
% Entering serif.
% Same as hookaserif, but with a VERTICAL flat spot.
%
subroutine hookcserif
	(index a, index flat, index b,
	 var vxflatl, var vyflatl, var vxflatr, var vyflatr, 
	 var valaimf, var varaimf,
	 var rightiswhichway):
% .....................................................................
% Position the points of tangency.
cpen;
if rightiswhichway=leftedge:
    rt0	x(flat+100)	= good0 vxflatl;
       	y(flat+100)	= vyflatl[y(a+100),y(b+100)];
   lft0	x(flat+300)	= good0 vxflatr;
       	y(flat+300)	= vyflatr[y(a+300),y(b+300)];
else: if rightiswhichway=rightedge:
   lft0	x(flat+100)	= good0 vxflatl;
       	y(flat+100)	= vyflatl[y(a+100),y(b+100)];
    rt0	x(flat+300)	= good0 vxflatr;
       	y(flat+300)	= vyflatr[y(a+300),y(b+300)];
else: call error;
fi; fi;

new w(flat+1100),w(flat+2100),w(flat+1300),w(flat+2300);
new w(a+1100),w(a+2100),w(a+1300),w(a+2300);
% and set the slope vertical.
	w(flat+1100)=0;	w(flat+2100)=y(b+100)-y(a+100);
	w(flat+1300)=0;	w(flat+2300)=y(b+100)-y(a+100);

	w(a+1100)	=  x(flat+100)-x(a+100);
	w(a+2100)	= (y(flat+100)-y(a+100))valaimf;
	w(a+1300)	=  x(flat+300)-x(a+300);
	w(a+2300)	= (y(flat+300)-y(a+300))varaimf;
.

% -------------------------------------------------------------------
% [from A ---- flat ---- B ---- .... ]
%
% Exiting serif.
% Same as hookbserif, but with a VERTICAL flat spot.
% Used, for instance, to create right diagonal stroke of roman lc "v".
%
subroutine hookdserif
	(index a, index flat, index b,
	 var vxflatl, var vyflatl, var vxflatr, var vyflatr, 
	 var vblaimf, var vbraimf,
	 var rightiswhichway):
% .....................................................................
% Position the points of tangency.
cpen;
if rightiswhichway=leftedge:
    rt0	x(flat+100)	= good0 vxflatl;
       	y(flat+100)	= vyflatl[y(a+100),y(b+100)];
   lft0	x(flat+300)	= good0 vxflatr;
       	y(flat+300)	= vyflatr[y(a+300),y(b+300)];
else: if rightiswhichway=rightedge:
   lft0	x(flat+100)	= good0 vxflatl;
        y(flat+100)	= vyflatl[y(a+100),y(b+100)];
    rt0	x(flat+300)	= good0 vxflatr;
       	y(flat+300)	= vyflatr[y(a+300),y(b+300)];
else: call error;
fi; fi;

new w(flat+1100),w(flat+2100),w(flat+1300),w(flat+2300);
new w(b+1100),w(b+2100),w(b+1300),w(b+2300);
% and set the slope horizontal.
	w(flat+1100)=0;	w(flat+2100)=y(b+100)-y(a+100);
	w(flat+1300)=0;	w(flat+2300)=y(b+100)-y(a+100);

% Aim the exiting slopes.
	w(b+1100)	=  x(b+100)-x(flat+100);
	w(b+2100)	= (y(b+100)-y(flat+100))vblaimf;
	w(b+1300)	=  x(b+300)-x(flat+300);
	w(b+2300)	= (y(b+300)-y(flat+300))vbraimf;
.

% -------------------------------------------------------------------
% puff [ A ---- turn ---- B ]
% Given two percentages alpha and beta,
% computes a new point called turn (and the slopes at the point)
% such that turn lies in the parallelogram defined by the intercepts
% at A and B. 
% For instance, if the parallelogram is a rectangle,
% alpha=beta=1/sqrt(2) gives an elliptical arc.
% The hidden point (interx,intery) is computed as
% the intersection of the vectors extending from A and B.
% The slope at (interx,intery) is the same as the slope from A to B.
subroutine puff
	(index a, index turn, index b,
	 var alpha,var beta):
% ........................................................................
	call intersect(a,b);
	xturn	= alpha[xa,interx] + (1-beta)(xb-interx);
	yturn	= alpha[ya,intery] + (1-beta)(yb-intery);
new w(turn+1000),w(turn+2000);
	w(turn+1000) = xb-xa;
	w(turn+2000) = yb-ya;
.


% -------------------------------------------------------------------
% Same as puff, except puffs both the left and right edges.
subroutine pufflr
	(index a, index turn, index b,
	 var alpha,var beta):
% ........................................................................
	call intersect((a+100),(b+100));
	x(turn+100)	= alpha[x(a+100),interx] + (1-beta)(x(b+100)-interx);
	y(turn+100)	= alpha[y(a+100),intery] + (1-beta)(y(b+100)-intery);
new w(turn+1100),w(turn+2100);
	w(turn+1100)	= x(b+100)-x(a+100);
	w(turn+2100)	= y(b+100)-y(a+100);

	call intersect((a+300),(b+300));
	x(turn+300)	= alpha[x(a+300),interx] + (1-beta)(x(b+300)-interx);
	y(turn+300)	= alpha[y(a+300),intery] + (1-beta)(y(b+300)-intery);
new w(turn+1300),w(turn+2300);
	w(turn+1300)	= x(b+300)-x(a+300);
	w(turn+2300)	= y(b+300)-y(a+300);
.


% -------------------------------------------------------------------
% Aims slopes so that the line from a to b dips down a certain amount.
subroutine dipdown
	(index a, index b, var vdip):
% .....................................................................
new w(a+1000),w(a+2000),w(b+1000),w(b+2000);
	w(a+1000)	= xb-xa;
	w(a+2000)	= yb-ya  -vdip;
	w(b+1000)	= xb-xa;
	w(b+2000)	= yb-ya  +vdip;
.

% -------------------------------------------------------------------
% Initial bracketed serif (attached at point b) with variable concavity.
subroutine aserif
	(index a, index b, index c, 
	 index d, index e, index f, index g, index h,
	 var serifthickness, var seriflength, var bracketlength,
	 var puffa, var puffb,
	 var vdip):
% .....................................................................
% Compute the point positions.
	xd	= xa;
	yd	= ya;
if xb<xa:
	xe = xb-seriflength;
else:	xe = xb+seriflength;
fi;
	call colinear(a,b,e);
	xf	= xe;
cpen;	yf	= ye-serifthickness;
	new extrabracketlength;
	extrabracketlength = bracketlength + serifthickness;
	call crawl(b,c,h,extrabracketlength);
% .....................................................................
% Compute their slopes.
	call dipdown(e,d,vdip);
new w(f+1000),w(f+2000),w(h+1000),w(h+2000);
	w(f+1000)	= w(e+1000);
	w(f+2000)	= w(e+2000);
	w(h+1000)	= w(b+1000);
	w(h+2000)	= w(b+2000);
	call puff(f,g,h, puffa,puffb);
.
% --------Stroke modification---------------------------------------

% -------------------------------------------------------------------
% Rounds out the join between ..a..b and c..d.. by actually changing
% the positions of b and c in accordance with some bracketing
% DISTANCE.
% Let p be the intersection of lines a--b and c--d.
% Then the result of CORNERFILL can be described as follows:
%	newb is between a and p.
%	newc is between p and d.
%	distance between p and newb is BRACKET.
%	distance between p and newc is BRACKET.
%
% Note: Normally CORNERFILL should be called 
% after points a,b,c,d are positioned. TAPERed and PUFFed points may be
% recomputed afterwards, if so desired.
%
subroutine cornerfill
	(index a, index b, index c, index d, var distance):
% .....................................................................
	call ptintersect(a,b,c,d);
	x99 = interx;
	y99 = intery;
	call crawl(99,a,1,distance);
	call crawl(99,d,2,distance);
new xb,yb,xc,yc;
	xb = x1;
	yb = y1;
	xc = x2;
	yc = y2;
.
% %	  LFLATTAPER
% % -------------------------------------------------------------------
% % Similar to taper, except that there are two waists,
% % the left and right edges have independent,
% % the left edge is straight between the two waists,
% % and the right edge collapses both waists into one.
% subroutine lflattaper(	index a, index b, index c, index d, 	
% 			var blbias,   var clbias,   var rbias,
% 			var bltaper,  var cltaper,  var rtaper,
% 			var blshrink, var clshrink, var rshrink):
% new brbias,crbias,brtaper,crtaper,brshrink,crshrink;
% brbias   = crbias   = rbias;
% brtaper  = crtaper  = rtaper;
% brshrink = crshrink = rshrink;
% % .....................................................................
% %	Calculate the endpoints of the waist as if the
% %	stroke were straight. These are strictly local
% %	temporary points.
% x1 = blbias[x(a+100),x(d+100)];
% y1 = blbias[y(a+100),y(d+100)];
% x2 = clbias[x(a+100),x(d+100)];
% y2 = clbias[y(a+100),y(d+100)];
% x3 = brbias[x(a+300),x(d+300)];
% y3 = brbias[y(a+300),y(d+300)];
% x4 = crbias[x(a+300),x(d+300)];
% y4 = crbias[y(a+300),y(d+300)];
% 
% %	Drop perpendiculars from the endpoints of the waists
% %	to the spine.
% call norm((d+200),(a+200));
% call intersect (a,xd-xa,yd-ya,	1,invertx,inverty);
% x211 = interx;
% y211 = intery;
% call norm((d+200),(a+200));
% call intersect (a,xd-xa,yd-ya,	2,invertx,inverty);
% x212 = interx;
% y212 = intery;
% call norm((a+200),(d+200));
% call intersect (a,xd-xa,yd-ya,	3,invertx,inverty);
% x213 = interx;
% y213 = intery;
% call norm((a+200),(d+200));
% call intersect (a,xd-xa,yd-ya,	3,invertx,inverty);
% x214 = interx;
% y214 = intery;
% 
% %	Compute the waist endpoints so that the stroke
% %	actually gets thinner in the middle.
% x(b+100) = blshrink[x1,x11];
% y(b+100) = blshrink[y1,y11];
% x(c+100) = clshrink[x2,x12];
% y(c+100) = clshrink[y2,y12];
% x(b+300) = brshrink[x3,x13];
% y(b+300) = brshrink[y3,x13];
% x(c+300) = brshrink[x4,x14];
% y(c+300) = brshrink[y4,x14];
% 
% % .....................................................................
% % 	Compute the waist slopes.
% new w(a+1100),w(a+2100),w(a+1300),w(a+2300);
% new w(b+1100),w(b+2100),w(b+1300),w(b+2300);
% new w(c+1100),w(c+2100),w(c+1300),w(c+2300);
% new w(d+1100),w(d+2100),w(d+1300),w(d+2300);
% 		% The left edge between the waists is flat,
% w(b+1100) = x(c+100)-x(b+100);
% w(c+1100) = x(c+100)-x(b+100);	
% w(b+2100) = y(c+100)-y(b+100);
% w(c+2100) = y(c+100)-y(b+100);
% 		% And the right edge at the waist is as in TAPER.
% w(b+1300) =
% w(c+1300) = rshrink[x(c+200)-x(a+200),x(c+300)-x(a+300)];
% w(b+2300) =
% w(c+2300) = rshrink[y(c+200)-y(a+200),y(c+300)-y(a+300)];
% 
% %	Compute the terminal slopes
% %	by aiming them at points along the waist lines.
% w(a+1100) = altaper[x1,x(b+100)] - x(a+100);
% w(a+2100) = altaper[y1,y(b+100)] - y(a+100);	
% w(a+1300) = artaper[x2,x(b+300)] - x(a+300);
% w(a+2300) = artaper[y2,y(b+300)] - y(a+300);
% 
% -w(d+1100) = cltaper[x1,x(c+100)] - x(d+100);
% -w(d+2100) = cltaper[y1,y(c+100)] - y(d+100);
% -w(d+1300) = crtaper[x2,x(c+300)] - x(d+300);
% -w(d+2300) = crtaper[y2,y(c+300)] - y(d+300);
% .
%